home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)Z / (A)Z9.ADF / Wormbench / Worms.mod < prev   
Text File  |  1987-11-27  |  5KB  |  153 lines
  1. MODULE Wormbench;  (* Wormbench 1.0  for Benchmark Modula-2 *)
  2. (*
  3.    Wormbench 1.0          - ] Mike SCARY Scalora [ -        PLink : SCARY
  4.  
  5.    This MODULE is public domain.   Freely distributable as long as this 
  6.    notice stays in.
  7.  
  8.    This program was originally uploaded to PeopleLink's Amiga Zone.  The 
  9.    Amiga Zone has well over 3000 members, and a library of thousands of 
  10.    public domain files.  If you're interested in joining us, call 
  11.       800-524-0100 (voice) 
  12.    or 800-826-8855 (modem).
  13. *)
  14. FROM System IMPORT argv, argc;
  15. FROM SYSTEM IMPORT ADR, ADDRESS, BYTE;
  16. FROM Intuition IMPORT CloseScreen, ScreenPtr, 
  17.                       ScreenFlags, ScreenFlagsSet, ScreenToFront,
  18.                       OpenWorkBench, CurrentTime,
  19.                       ShowTitle;
  20. FROM Drawing IMPORT DrawEllipse, SetWrMsk, SetAPen, SetDrMd;
  21. FROM Blit IMPORT BltBitMap, MinTermFlagsSet;
  22. FROM Views IMPORT LoadRGB4;
  23. FROM Rasters IMPORT Jam1, Jam2;
  24. FROM SimpleScreens IMPORT CreateScreen, ScreenOptFlags;
  25. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  26. FROM Terminal IMPORT WriteString;
  27. FROM MathLib0 IMPORT real, entier, sin, cos, DegToRad,
  28.                      MathTransName, MathTransBase;
  29. FROM Libraries    IMPORT OpenLibrary, CloseLibrary;
  30. FROM Tasks        IMPORT TaskPtr, FindTask;
  31.  
  32. VAR
  33.   WBScrn,  
  34.   MyScrn  : ScreenPtr;
  35.   MyTask  : TaskPtr;
  36.   Colors  : ARRAY [0..7] OF CARDINAL;
  37.   Worm    : ARRAY [1..10] OF RECORD
  38.               dir : REAL;
  39.               x   : ARRAY [1..20] OF INTEGER;
  40.               y   : ARRAY [1..20] OF INTEGER;
  41.             END;
  42.   movex,
  43.   movey   : REAL;
  44.   radx,
  45.   rady    : INTEGER;
  46.   
  47.   H,W,
  48.   WC,NW   : CARDINAL;
  49.   NX,NY   : INTEGER;
  50.   Secs, 
  51.   Micros  : LONGCARD;  
  52.   
  53. PROCEDURE Halt;
  54.   BEGIN
  55.     IF MyScrn#NIL THEN CloseScreen(MyScrn^); END;
  56.     IF MathTransBase#NIL THEN CloseLibrary(MathTransBase^); END;
  57.     HALT;
  58.   END Halt;
  59.  
  60. BEGIN
  61.   MyTask := FindTask(NIL);
  62.   MyScrn := NIL; 
  63.   MathTransBase := OpenLibrary(ADR(MathTransName), 0D);
  64.   IF MathTransBase=NIL THEN
  65.     WriteString("ERROR: 'mathtrans.library' not found!\n"); Halt; END;
  66.   WBScrn := OpenWorkBench();
  67.   IF WBScrn=NIL THEN WriteString('Could not get WB ScreenPtr!\n'); Halt; END;
  68.   Colors[0] := WBScrn^.ViewPort.ColorMap^.ColorTable^[0];
  69.   Colors[1] := WBScrn^.ViewPort.ColorMap^.ColorTable^[1];
  70.   Colors[2] := WBScrn^.ViewPort.ColorMap^.ColorTable^[2];
  71.   Colors[3] := WBScrn^.ViewPort.ColorMap^.ColorTable^[3];
  72.   Colors[4] := 0D74H;  Colors[5] := 0D74H;
  73.   Colors[6] := 0D74H;  Colors[7] := 0D74H;
  74.   ScreenOptFlags := ScreenFlagsSet{ScreenBehind};
  75.   IF WBScrn^.Height>320 THEN H := 400; ELSE H := 200; END;
  76.   MyScrn := CreateScreen(640,H,3,NIL);
  77.   IF MyScrn=NIL THEN WriteString('Could not open screen!\n'); Halt; END;
  78.   ShowTitle(MyScrn^,FALSE);
  79.   LoadRGB4(MyScrn^.ViewPort,ADR(Colors),8);
  80. (*****************
  81.   MyWind := CreateWindow(0,0,640,H,IDCMPFlagsSet{},
  82.     WindowFlagsSet{BackDrop,Borderless,Activate},
  83.     NIL,MyScrn,NIL);
  84.   IF MyWind=NIL THEN WriteString('Could not open window!\n'); Halt; END;
  85.  ******************)
  86.  
  87.   WriteString('\nWormbench 1.0  - ] Mike SCARY Scalora [ -\n\n');
  88.   WriteString('TIUQ OT C-LRTC\n\n');
  89.  
  90.   IF BltBitMap(WBScrn^.BitMap,0,0,
  91.                MyScrn^.BitMap,0,0,
  92.                640,INTEGER(H),
  93.                MinTermFlagsSet(0C0H),BYTE(03H),NIL)=0D THEN
  94.     WriteString('Error on BltBitMap!\n');
  95.   END;
  96.  
  97.   NW := 5;
  98.  
  99.   IF (argc>1) AND (argv^[1]^[0]>='0') AND (argv^[1]^[0]<='9') THEN
  100.     NW := ORD(argv^[1]^[0])-ORD('0'); END;
  101.   IF NW=0 THEN NW := 10; END;
  102.  
  103.   movex := 8.0;
  104.   radx := 6;
  105.   IF H=400 THEN movey := 8.0; rady := 6;
  106.            ELSE movey := 4.0; rady := 3; END;
  107.  
  108.   FOR W := 1 TO NW DO
  109.     Worm[W].dir := DegToRad(FLOAT(360 DIV NW * W));
  110.     FOR WC := 1 TO 20 DO
  111.       Worm[W].x[WC] := 320;
  112.       Worm[W].y[WC] := H DIV 2;
  113.     END;
  114.   END;
  115.  
  116.   WC := 1;
  117.  
  118.   ScreenToFront(MyScrn^);
  119.  
  120.   SetWrMsk(MyScrn^.RastPort,BYTE(4));
  121.   SetDrMd(MyScrn^.RastPort,Jam1);
  122.   
  123.   LOOP
  124.     IF 12 IN MyTask^.tcSigRecvd THEN EXIT; END;
  125.     FOR W := 1 TO NW DO
  126.       SetAPen(MyScrn^.RastPort,0);
  127.       DrawEllipse(MyScrn^.RastPort,Worm[W].x[WC]+10,
  128.                                   Worm[W].y[WC]+10,radx,rady);
  129.       CurrentTime(ADR(Secs),ADR(Micros));
  130.       IF 0 IN BITSET(Micros) THEN 
  131.         Worm[W].dir := Worm[W].dir + 0.1475;
  132.       ELSE 
  133.         Worm[W].dir := Worm[W].dir - 0.1475;
  134.       END;
  135.       IF WC=1 THEN NX := Worm[W].x[20]; NY := Worm[W].y[20];
  136.       ELSE NX := Worm[W].x[WC-1]; NY := Worm[W].y[WC-1]; END;
  137.       NX := NX + TRUNC(movex * cos(Worm[W].dir));
  138.       NY := NY + TRUNC(movey * sin(Worm[W].dir));
  139.       IF NX<0 THEN Worm[W].x[WC] := NX + 620; 
  140.       ELSIF NX>619 THEN Worm[W].x[WC] := NX - 620;
  141.       ELSE Worm[W].x[WC] := NX; END;
  142.       IF NY<0 THEN Worm[W].y[WC] := NY + INTEGER(H-20); 
  143.       ELSIF NY>=INTEGER(H-21) THEN Worm[W].y[WC] := NY - INTEGER(H-20);
  144.       ELSE Worm[W].y[WC] := NY; END;
  145.       SetAPen(MyScrn^.RastPort,4);
  146.       DrawEllipse(MyScrn^.RastPort,Worm[W].x[WC]+10,
  147.                                    Worm[W].y[WC]+10,radx,rady);
  148.     END;
  149.     WC := (WC MOD 20) + 1;
  150.   END;  
  151.   Halt;
  152. END Wormbench.
  153.